perm filename T[ALS,ALS] blob sn#176250 filedate 1975-09-08 generic text, type T, neo UTF8
00100	COMMENT ⊗   VALID 00002 PAGES
00200	C REC  PAGE   DESCRIPTION
00300	C00001 00001
00400	C00002 00002	BEGIN "BOWLS"
00500	C00009 ENDMK
00600	C⊗;
     

00100	BEGIN "BOWLS"
00200	DEFINE ⊂="BEGIN",⊃="END",$="COMMENT";
00300	DEFINE \=" "; $ DEFINE \="SAFE";	$ Simple way to change to SAFE;
00400	
00500	INTEGER ARRAY BUF[0:511];
00600	INTEGER I,J,K,L,LENX,SIDEOF,BRCHR,CHAN1,CHAN2,EOF,SIDE;
00700	REAL SCORE,RATING,DELTA;
00800	STRING READ1,READ2,READ3,READX;
00900	BOOLEAN ER;
01000	
01100	PROCEDURE NEWNAM;		$ Adds a new mname to the list;
01200	⊂	"NEW"
01300		BUF[I]←CVSIX(READX);
01400		OUTSTR ("Type full name for record = ");
01500		READ1←INCHWL;
01600		I←I+1;
01700		FOR J←1 STEP 5 UNTIL 16 DO 
01800	 ⊂	BUF[I]←CVASC(READ1[J FOR 5]);
01900		I←I+1;
02000	 ⊃	;
02100		OUTSTR ("Type Apartment number = ");
02200		BUF[I+1]←CVSIX(INCHWL);
02300		OUTSTR ("Type approximate rating = ");
02400		BUF[I+2]←0;
02500		BUF[I+3]←CVD(INCHWL);
02600	⊃	"NEW";
02700	
02800	PROCEDURE MKROOM;
02900	⊂	FOR K←J STEP 8 UNTIL 504 DO IF BUF[K]=0 THEN DONE;
03000		IF K≥504 THEN OUTSTR("Too many players! ") ELSE
03100		FOR K←K+7 STEP -1 UNTIL I DO BUF[K+8]←BUF[K];
03200	⊃	;
03300	
03400	PROCEDURE NAME;
03500	⊂	"NAME"			$ Returns index in I for location of nickname;
03600		WHILE TRUE DO
03700	 ⊂	"TLOOP"
03800		OUTSTR ("Type NICKNAME = ");
03900		READ1←INCHWL;
04000		IF READ1="" THEN DONE;
04100		IF READ1≥175 THEN DONE;
04200		LENX←LENGTH(READ1);
04300		READX←"";
04400		READX←CVXSTR(CVSIX(READ1));
04500		FOR I←0 STEP 8 UNTIL 511 DO
04600	  ⊂	"ILOOP"
04700		IF BUF[I]=0 THEN
04800	   ⊂	OUTSTR ("Is this a new nickname? (Y or N) ");
04900		IF INCHWL="Y" THEN
05000	    ⊂	MKROOM;
05100		BUF[I]←CVSIX(READX);
05200		NEWNAM;
05300		DONE "TLOOP";
05400	    ⊃	ELSE DONE;
05500	   ⊃	;
05600		READ1←CVXSTR(BUF[I])[1 FOR LENX];
05700		IF READX≥READ1 THEN
05800	   ⊂	"FOUND"
05900		J←I+8;
06000		IF (J>511)∨(BUF[J]=0) THEN READ2←"ZZZZZ"
06100		ELSE  READ2←CVXSTR(BUF[J])[1 FOR LENX];
06200		IF READ1=READ2 THEN
06300	    ⊂	OUTSTR ("Ambiguous! type more letters ");  DONE "ILOOP";
06400	    ⊃	;
06500		IF READX=READ1 THEN DONE "TLOOP";
06600		IF READX<READ2 THEN
06700	    ⊂	"NONE"
06800		OUTSTR ("Is this a new nickname? (Y or N) ");
06900		IF INCHWL="Y" THEN
07000	     ⊂	MKROOM;
07100		NEWNAM;
07200		DONE "TLOOP";
07300	     ⊃	ELSE
07400	     ⊂ 	FOR K←1 STEP 1 UNTIL LENX DO IF READX[K FOR 1]≠READ1[K FOR 1] THEN DONE;
07500		FOR L←1 STEP 1 UNTIL LENX DO IF READX[L FOR 1]≠READ2[L FOR 1] THEN DONE;
07600		IF K>L THEN
07700	      ⊂	OUTSTR ("Do you mean "&READ1&" Y or N? ");
07800		IF INCHWL="Y" THEN
07900	       ⊂	READX←READ1;
08000		 	DONE "TLOOP";
08100	       ⊃	;
08200	      ⊃	;
08300		IF K<L THEN
08400	      ⊂	OUTSTR ("Do you mean "&READ2&" Y or N? ");
08500		IF INCHWL="Y" THEN
08600	       ⊂	READX←READ2;
08700			I←I+8;
08800			DONE "TLOOP";
08900	       ⊃	;
09000	      ⊃	;
09100	     ⊃	;
09200	    ⊃	"NONE";
09300	   ⊃	"FOUND";
09400	  ⊃	"ILOOP";
09500		OUTSTR ("Try again ");
09600	 ⊃	"TLOOP";
09700	⊃	"NAME";
09800	
09900	
10000	PROCEDURE UPDATE;
10100	⊂	WHILE TRUE DO
10200	 ⊂	NAME;
10300		IF READX="" THEN DONE;
10400		K←BUF[I+6]+1;
10500		OUTSTR(CVXSTR(BUF[I])&11);
10600		FOR J←I+1 STEP 1 UNTIL 5 DO OUTSTR(CVSTR(BUF[J]));
10700		OUTSTR(11&CVS(K)&11);
10800		OUTSTR(11&CVF(BUF[I+5])&" changed to ");
10900		RATING←((BUF[I+5]*3)+DELTA)/4;
11000		OUTSTR(CVF(RATING));
11100		OUTSTR(" Space bar if OK, Return if not ");
11200		IF INCHWL='40 THEN
11300	  ⊂	BUF[I+6]←K;	BUF[I+5]←RATING;
11400	  ⊃	;
11500	 ⊃	;
11600	⊃	;
11700	
11800	
11900	PROCEDURE CORRECT;
12000	⊂	"CORRECT"
12100		WHILE TRUE DO
12200	 ⊂
12300	
12400	
12500	
12600	
12700	
12800	
12900	
13000	
13100	
13200		NAME;					$ Ask for nickname;
13300		IF READX="" THEN DONE;
13400	 ⊃	;
13500	⊃	"CORRECT";
13600	
13700	PROCEDURE REPORT;
13800	⊂	"REPORT"
13900	
14000	
14100	
14200	
14300	
14400	
14500	
14600	
14700	
14800	
14900	
15000	
15100	⊃	"REPORT";
15200	
15300	PROCEDURE GAME;
15400	⊂	"GAME"
15500		SETFORMAT(5,3);
15600		WHILE TRUE DO
15700	 ⊂	OUTSTR("Type score difference ");
15800		IF (READ1←INCHWL)="" THEN DONE;
15900		DELTA←CVD(READ1);
16000		OUTSTR("Type number on each side");
16100		SIDE←CVD(INCHWL);
16200		DELTA←DELTA/SIDE;
16300		OUTSTR("List winners by nickname ");
16400		UPDATE;
16500		OUTSTR("List losers by nickname ");
16600		UPDATE;
16700	 ⊃	;
16800	⊃	"GAME";
16900	
17000	PROCEDURE NLIST;
17100	⊂	"NLIST"
17200	
17300	
17400	
17500	
17600	
17700	
17800	
17900	
18000	
18100	
18200	
18300	
18400	⊃	"NLIST";
18500	
18600	PROCEDURE GLIST;
18700	⊂	"GLIST"
18800	
18900	
19000	
19100	
19200	
19300	
19400	
19500	
19600	
19700	⊃	"GLIST";
19800	
19900	$ MAIN PROGRAM STARTS HERE;
20000	
20100	CHAN1←1;	CHAN2←2;
20200	CLOSE (CHAN1);	OPEN (CHAN1,"DSK",'10,2,0,0,0,EOF);
20300	LOOKUP (CHAN1,"BOWL.DAT[ALS,ALS]",ER);
20400	IF ER THEN OUTSTR ("BOWLD.DAT does not exist.
20500	") ELSE
20600	ARRYIN(CHAN1,BUF[0],512);
20700	CLOSE(CHAN1);
20800	
20900	
21000	$ Main program loop starts here;
21100	
21200		WHILE TRUE DO
21300	 ⊂	OUTSTR 
21400	("Services available are:	0. Exit call.	1. Add game.	2. Add name.
21500		3. Make correction.	4. Ratings.	5. List names.	6. List games.
21600	Type number for service requested = ");
21700		I←0;
21800		I←CVD(INCHWL);
21900		IF (I>6)∨(I≤0) THEN DONE;
22000		CASE I OF ⊂ ;GAME;NAME;CORRECT;REPORT;NLIST;GLIST; ⊃ ;
22100	 ⊃ ;
22200	CLOSE (CHAN2);	OPEN (CHAN2,"DSK",'10,0,2,0,0,EOF);
22300	ENTER (CHAN2,"BOWL.DAT[ALS,ALS]",ER);
22400	ARRYOUT (CHAN2,BUF[0],512);	CLOSE(CHAN2); RELEAS(CHAN2);
22500	⊃ "BOWLS";